home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / x11 / x-menubar.el.z / x-menubar.el
Encoding:
Text File  |  1998-05-21  |  56.0 KB  |  1,607 lines
  1. ;;; x-menubar.el --- Menubar and popup-menu support for X.
  2.  
  3. ;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  5. ;; Copyright (C) 1995 Sun Microsystems.
  6. ;; Copyright (C) 1995, 1996 Ben Wing.
  7. ;; Copyright (C) 1997 MORIOKA Tomohiko
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with Xmacs; see the file COPYING.  If not, write to the 
  23. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Code:
  29.  
  30. ;;; Warning-free compile
  31. (eval-when-compile
  32.   (defvar language-environment-list)
  33.   (require 'pending-del))
  34.  
  35. (defconst default-menubar
  36.   (purecopy-menubar
  37.    ;; note backquote.
  38.    `(
  39.      ("File"
  40.       :filter file-menu-filter
  41.       ["Open..."        find-file        t]
  42.       ["Open in Other Window..." find-file-other-window    t]
  43.       ["Open in New Frame..."    find-file-other-frame    t]
  44.       ["Insert File..."     insert-file        t]
  45.       ["View File..."        view-file        t]
  46.       "------"
  47.       ["Save"            save-buffer        t  nil]
  48.       ["Save As..."        write-file        t]
  49.       ["Save Some Buffers"    save-some-buffers    t]
  50.       "-----"
  51.       ["Print Buffer"        lpr-buffer        t  nil]
  52.       ["Pretty-Print Buffer"    ps-print-buffer-with-faces t  nil]
  53.       "-----"
  54.       ["New Frame"        make-frame        t]
  55.       ["Frame on Other Display..."
  56.                 make-frame-on-display    t]
  57.       ["Delete Frame"        delete-frame        t]
  58.       "-----"
  59.       ["Split Window"        split-window-vertically t]
  60.       ["Un-Split (Keep This)"    delete-other-windows    (not (one-window-p t))]
  61.       ["Un-Split (Keep Others)"    delete-window        (not (one-window-p t))]
  62.       "-----"
  63.       ["Revert Buffer"        revert-buffer         t  nil]
  64.       ["Delete Buffer"        kill-this-buffer     t  nil]
  65.       "-----"
  66.       ["Exit XEmacs"        save-buffers-kill-emacs    t]
  67.       )
  68.  
  69.      ("Edit"
  70.       :filter edit-menu-filter
  71.       ["Undo"            advertised-undo           t]
  72.       ["Cut"            x-kill-primary-selection   t]
  73.       ["Copy"            x-copy-primary-selection   t]
  74.       ["Paste"            x-yank-clipboard-selection t]
  75.       ["Clear"            x-delete-primary-selection t]
  76.       "----"
  77.       ["Search..."        isearch-forward        t]
  78.       ["Search Backward..."    isearch-backward    t]
  79.       ["Replace..."        query-replace        t]
  80.       "----"
  81.       ["Search (Regexp)..."    isearch-forward-regexp    t]
  82.       ["Search Backward (Regexp)..." isearch-backward-regexp t]
  83.       ["Replace (Regexp)..."    query-replace-regexp    t]
  84.       "----"
  85.       ("Bookmarks"
  86.        ("Jump to bookmark"
  87.     :filter bookmark-menu-filter)
  88.        ["Set bookmark"      bookmark-set        t]
  89.        "---"
  90.        ["Insert contents"      bookmark-menu-insert    t]
  91.        ["Insert location"      bookmark-menu-locate    t]
  92.        "---"
  93.        ["Rename bookmark"      bookmark-menu-rename    t]
  94.        ("Delete bookmark"
  95.       :filter bookmark-delete-filter)
  96.        ["Edit Bookmark List"    bookmark-bmenu-list    t]
  97.        "---"
  98.        ["Save bookmarks"        bookmark-save        t]
  99.        ["Save bookmarks as..."  bookmark-write        t]
  100.        ["Load a bookmark file"  bookmark-load        t])
  101.       "----"
  102.       ["Goto Line..."        goto-line        t]
  103.       ["What Line"        what-line        t]
  104.       "----"
  105.       ["Start Macro Recording"    start-kbd-macro          (not defining-kbd-macro)]
  106.       ["End Macro Recording"    end-kbd-macro        defining-kbd-macro]
  107.       ["Execute Last Macro"    call-last-kbd-macro    last-kbd-macro]
  108.       "----"
  109.       ["Show Message Log"    show-message-log    t]
  110.       )
  111.      
  112.      ,@(if (featurep 'mule)
  113.        '(("Mule"
  114.           ("Describe language support")
  115.           ("Set language environment")
  116.           "--"
  117.           ["Toggle input method" toggle-input-method t]
  118.           ["Select input method" select-input-method t]
  119.           ["Describe input method" describe-input-method t]
  120.           "--"
  121.           ["Describe current coding systems"
  122.            describe-current-coding-system t]
  123.           ["Set coding system of buffer file"
  124.            set-buffer-file-coding-system t]
  125.           ["Set coding system of terminal"
  126.            set-terminal-coding-system nil] ; not implemented yet
  127.           ["Set coding system of keyboard"
  128.            set-keyboard-coding-system nil] ; not implemented yet
  129.           ["Set coding system of process"
  130.            set-current-process-coding-system nil] ; not implemented yet
  131.           "--"
  132.           ["Show character table" view-charset-by-menu t]
  133.           ["Show diagnosis for MULE" mule-diag nil] ; not implemented yet
  134.           ["Show many languages" view-hello-file t]
  135.           )))
  136.      
  137.      ("Apps"
  138.       ["Read Mail (VM)..."    vm            t]
  139.       ["Read Mail (MH)..."    (mh-rmail t)        t]
  140.       ["Send mail..."        mail            t]
  141.       ["Usenet News"        gnus            (fboundp 'gnus)]
  142.       ["Browse the Web"        w3            t]
  143.       ["Gopher"            gopher            t]
  144.       "----"
  145.       ["Spell-Check Buffer"    ispell-buffer        t]
  146.       ["Toggle VI emulation"        toggle-viper-mode        t]
  147.       "----"
  148.       ("Calendar"
  149.        ["3-Month Calendar"    calendar        t]
  150.        ["Diary"            diary            t]
  151.        ["Holidays"        holidays        t]
  152.        ;; we're all pagans at heart ...
  153.        ["Phases of the Moon"    phases-of-moon        t]
  154.        ["Sunrise/Sunset"    sunrise-sunset        t]
  155.        )
  156.       ("Games"
  157.        ["Mine Game"        xmine            t]
  158.        ["Tetris"        tetris            t]
  159.        ["Quote from Zippy"    yow            t]
  160.        ["Psychoanalyst"        doctor            t]
  161.        ["Psychoanalyze Zippy!"    psychoanalyze-pinhead    t]
  162.        ["Random Flames"        flame            t]
  163.        ["Dunnet (Adventure)"    dunnet            t]
  164.        ["Towers of Hanoi"    hanoi            t]
  165.        ["Game of Life"        life            t]
  166.        ["Multiplication Puzzle"    mpuz            t]
  167.        )
  168.       )
  169.  
  170.      ("Options"
  171.       ("Customize"
  172.        ("Emacs" :filter (lambda (&rest junk)
  173.                (cdr (custom-menu-create 'emacs))))
  174.        ["Group..." customize-group t]
  175.        ["Variable..." customize-variable t]
  176.        ["Face..." customize-face t]
  177.        ["Saved..." customize-saved t]
  178.        ["Set..." customize-customized t]
  179.        ["Apropos..." customize-apropos t])
  180.       ["Read Only" (toggle-read-only)
  181.        :style toggle :selected buffer-read-only]
  182.       ("Editing Options"
  183.        ["Overstrike" (progn
  184.                (overwrite-mode current-prefix-arg)
  185.                (setq-default overwrite-mode overwrite-mode))
  186.     :style toggle :selected overwrite-mode]
  187.        ["Case Sensitive Search" (progn
  188.                   (setq case-fold-search (not case-fold-search))
  189.                   (setq-default case-fold-search
  190.                         case-fold-search))
  191.     :style toggle :selected (not case-fold-search)]
  192.        ["Case Matching Replace" (setq case-replace (not case-replace))
  193.     :style toggle :selected case-replace]
  194.        ["Auto Delete Selection" (pending-delete-mode
  195.                  (if pending-delete-mode 0 1))
  196.     :style toggle
  197.     :selected (and (boundp 'pending-delete-mode) pending-delete-mode)]
  198.        ["Active Regions" (setq zmacs-regions (not zmacs-regions))
  199.     :style toggle :selected zmacs-regions]
  200.        ["Mouse Paste At Text Cursor" (setq mouse-yank-at-point
  201.                        (not mouse-yank-at-point))
  202.     :style toggle :selected mouse-yank-at-point]
  203.        ["Require Newline At End" (setq require-final-newline
  204.                        (or (eq require-final-newline 'ask)
  205.                        (not require-final-newline)))
  206.     :style toggle :selected (eq require-final-newline 't)]
  207.        ["Add Newline When Moving Past End" (setq next-line-add-newlines
  208.                          (not next-line-add-newlines))
  209.     :style toggle :selected next-line-add-newlines]
  210.        )
  211.       ("General Options"
  212.        ["Teach Extended Commands" (setq teach-extended-commands-p
  213.                     (not teach-extended-commands-p))
  214.     :style toggle :selected teach-extended-commands-p]
  215.        ["Debug On Error" (setq debug-on-error (not debug-on-error))
  216.     :style toggle :selected debug-on-error]
  217.        ["Debug On Quit" (setq debug-on-quit (not debug-on-quit))
  218.     :style toggle :selected debug-on-quit]
  219.        )
  220.       ("Printing Options"
  221.        ["Command-Line Switches for `lpr'/`lp'..."
  222.     (setq lpr-switches
  223.           (read-expression "Switches for `lpr'/`lp': "
  224.                    (format "%S" lpr-switches)))
  225.     t]
  226.        ("Pretty-Print Paper Size"
  227.     ["Letter"
  228.      (setq ps-paper-type 'letter)
  229.      :style radio
  230.      :selected (eq ps-paper-type 'letter)]
  231.     ["Letter-small"
  232.      (setq ps-paper-type 'letter-small)
  233.      :style radio
  234.      :selected (eq ps-paper-type 'letter-small)]
  235.     ["Legal"
  236.      (setq ps-paper-type 'legal)
  237.      :style radio
  238.      :selected (eq ps-paper-type 'legal)]
  239.     ["Statement"
  240.      (setq ps-paper-type 'statement)
  241.      :style radio
  242.      :selected (eq ps-paper-type 'statement)]
  243.     ["Executive"
  244.      (setq ps-paper-type 'executive)
  245.      :style radio
  246.      :selected (eq ps-paper-type 'executive)]
  247.     ["Tabloid"
  248.      (setq ps-paper-type 'tabloid)
  249.      :style radio
  250.      :selected (eq ps-paper-type 'tabloid)]
  251.     ["Ledger"
  252.      (setq ps-paper-type 'ledger)
  253.      :style radio
  254.      :selected (eq ps-paper-type 'ledger)]
  255.     ["A3"
  256.      (setq ps-paper-type 'a3)
  257.      :style radio
  258.      :selected (eq ps-paper-type 'a3)]
  259.     ["A4"
  260.      (setq ps-paper-type 'a4)
  261.      :style radio
  262.      :selected (eq ps-paper-type 'a4)]
  263.     ["A4small"
  264.      (setq ps-paper-type 'a4small)
  265.      :style radio
  266.      :selected (eq ps-paper-type 'a4small)]
  267.     ["B4"
  268.      (setq ps-paper-type 'b4)
  269.      :style radio
  270.      :selected (eq ps-paper-type 'b4)]
  271.     ["B5"
  272.      (setq ps-paper-type 'b5)
  273.      :style radio
  274.      :selected (eq ps-paper-type 'b5)]
  275.     )
  276.        ["Enable Color Printing"
  277.     (progn
  278.       (set-face-background 'default "white")
  279.       (setq ps-print-color-p t))
  280.     t]
  281.        )
  282.       ("\"Other Window\" Location"
  283.        ["Always in Same Frame"
  284.     (setq get-frame-for-buffer-default-instance-limit nil)
  285.     :style radio
  286.     :selected (null get-frame-for-buffer-default-instance-limit)]
  287.        ["Other Frame (2 Frames Max)"
  288.     (setq get-frame-for-buffer-default-instance-limit 2)
  289.     :style radio
  290.     :selected (eq 2 get-frame-for-buffer-default-instance-limit)]
  291.        ["Other Frame (3 Frames Max)"
  292.     (setq get-frame-for-buffer-default-instance-limit 3)
  293.     :style radio
  294.     :selected (eq 3 get-frame-for-buffer-default-instance-limit)]
  295.        ["Other Frame (4 Frames Max)"
  296.     (setq get-frame-for-buffer-default-instance-limit 4)
  297.     :style radio
  298.     :selected (eq 4 get-frame-for-buffer-default-instance-limit)]
  299.        ["Other Frame (5 Frames Max)"
  300.     (setq get-frame-for-buffer-default-instance-limit 5)
  301.     :style radio
  302.     :selected (eq 5 get-frame-for-buffer-default-instance-limit)]
  303.        ["Always Create New Frame"
  304.     (setq get-frame-for-buffer-default-instance-limit 0)
  305.     :style radio
  306.     :selected (eq 0 get-frame-for-buffer-default-instance-limit)]
  307.        "-----"
  308.        ["Temp Buffers Always in Same Frame"
  309.     (setq temp-buffer-show-function 'show-temp-buffer-in-current-frame)
  310.     :style radio
  311.     :selected (eq temp-buffer-show-function
  312.               'show-temp-buffer-in-current-frame)]
  313.        ["Temp Buffers Like Other Buffers"
  314.     (setq temp-buffer-show-function nil)
  315.     :style radio
  316.     :selected (null temp-buffer-show-function)]
  317.        "-----"
  318.        ["Make current frame gnuserv target"
  319.     (setq gnuserv-frame
  320.           (if (equal gnuserv-frame (selected-frame))
  321.           'new
  322.         (selected-frame)))
  323.     :style radio
  324.     :selected (equal gnuserv-frame (selected-frame))]
  325.        )
  326.  
  327.       "-----"
  328.       ("Syntax Highlighting" 
  329.        ["In This Buffer" (font-lock-mode)
  330.     :style toggle :selected font-lock-mode]
  331.        ["Automatic" (if (not (featurep 'font-lock))
  332.                (progn
  333.                  (setq font-lock-auto-fontify t)
  334.                  (require 'font-lock))
  335.              (setq font-lock-auto-fontify
  336.                    (not font-lock-auto-fontify)))
  337.     :style toggle
  338.     :selected (and (featurep 'font-lock) font-lock-auto-fontify)]
  339.        "-----"
  340.        ["Fonts" (progn (require 'font-lock)
  341.                (font-lock-use-default-fonts)
  342.                (setq font-lock-use-fonts t
  343.                  font-lock-use-colors nil)
  344.                (font-lock-mode 1))
  345.     :style radio
  346.     :selected (and font-lock-mode
  347.                font-lock-use-fonts)]
  348.        ["Colors" (progn (require 'font-lock)
  349.             (font-lock-use-default-colors)
  350.             (setq font-lock-use-colors t 
  351.                   font-lock-use-fonts nil)
  352.             (font-lock-mode 1))
  353.     :style radio
  354.     :selected (and font-lock-mode
  355.                font-lock-use-colors)]
  356.        "-----"
  357.        ["Least" (if (or (and (not (integerp font-lock-maximum-decoration))
  358.                  (not (eq t font-lock-maximum-decoration)))
  359.             (and (integerp font-lock-maximum-decoration)
  360.                  (<= font-lock-maximum-decoration 0)))
  361.             nil
  362.           (setq font-lock-maximum-decoration nil)
  363.           (font-lock-recompute-variables))
  364.     :style radio
  365.     :active font-lock-mode
  366.     :selected (and font-lock-mode
  367.                (or (and (not (integerp font-lock-maximum-decoration))
  368.                 (not (eq t font-lock-maximum-decoration)))
  369.                (and (integerp font-lock-maximum-decoration)
  370.                 (<= font-lock-maximum-decoration 0))))]
  371.        ["More" (if (and (integerp font-lock-maximum-decoration)
  372.             (= 1 font-lock-maximum-decoration))
  373.            nil
  374.          (setq font-lock-maximum-decoration 1)
  375.          (font-lock-recompute-variables))
  376.     :style radio
  377.     :active font-lock-mode
  378.     :selected (and font-lock-mode
  379.                (integerp font-lock-maximum-decoration)
  380.                (= 1 font-lock-maximum-decoration))]
  381.        ["Even More" (if (and (integerp font-lock-maximum-decoration)
  382.                  (= 2 font-lock-maximum-decoration))
  383.             nil
  384.               (setq font-lock-maximum-decoration 2)
  385.               (font-lock-recompute-variables))
  386.     :style radio
  387.     :active font-lock-mode
  388.     :selected (and font-lock-mode
  389.                (integerp font-lock-maximum-decoration)
  390.                (= 2 font-lock-maximum-decoration))]
  391.        ["Most" (if (or (eq font-lock-maximum-decoration t)
  392.                (and (integerp font-lock-maximum-decoration)
  393.                 (>= font-lock-maximum-decoration 3)))
  394.            nil
  395.          (setq font-lock-maximum-decoration t)
  396.          (font-lock-recompute-variables))
  397.     :style radio
  398.     :active font-lock-mode
  399.     :selected (and font-lock-mode
  400.                (or (eq font-lock-maximum-decoration t)
  401.                (and (integerp font-lock-maximum-decoration)
  402.                 (>= font-lock-maximum-decoration 3))))]
  403.        "-----"
  404.        ["Lazy" (progn (require 'lazy-shot)
  405.               (if (and (boundp 'lazy-shot-mode) lazy-shot-mode)
  406.               (progn
  407.                 (lazy-shot-mode 0)
  408.                 ;; this shouldn't be necessary so there has to
  409.                 ;; be a redisplay bug lurking somewhere (or
  410.                 ;; possibly another event handler bug)
  411.                 (redraw-modeline)
  412.                 (remove-hook 'font-lock-mode-hook
  413.                      'turn-on-lazy-shot))
  414.             (if font-lock-mode
  415.                 (progn
  416.                   (lazy-shot-mode 1)
  417.                   (redraw-modeline)
  418.                   (add-hook 'font-lock-mode-hook
  419.                     'turn-on-lazy-shot)))))
  420.     :active font-lock-mode
  421.     :style toggle
  422.     :selected (and (boundp 'lazy-shot-mode) lazy-shot-mode)]
  423.        ["Caching" (progn (require 'fast-lock)
  424.              (if fast-lock-mode
  425.                  (progn
  426.                    (fast-lock-mode 0)
  427.                    ;; this shouldn't be necessary so there has to
  428.                    ;; be a redisplay bug lurking somewhere (or
  429.                    ;; possibly another event handler bug)
  430.                    (redraw-modeline))
  431.                (if font-lock-mode
  432.                    (progn
  433.                  (fast-lock-mode 1)
  434.                  (redraw-modeline)))))
  435.     :active font-lock-mode
  436.     :style toggle
  437.     :selected (and (boundp 'fast-lock-mode) fast-lock-mode)]
  438.        )
  439.       ("Paren Highlighting"
  440.        ["None" (paren-set-mode -1)
  441.     :style radio :selected (not paren-mode)]
  442.        ["Blinking Paren" (paren-set-mode 'blink-paren)
  443.     :style radio :selected (eq paren-mode 'blink-paren)]
  444.        ["Steady Paren" (paren-set-mode 'paren)
  445.     :style radio :selected (eq paren-mode 'paren)]
  446.        ["Expression" (paren-set-mode 'sexp)
  447.     :style radio :selected (eq paren-mode 'sexp)]
  448. ;;;       ["Nested Shading" (paren-set-mode 'nested)
  449. ;;;        :style radio :selected (eq paren-mode 'nested)]
  450.        )
  451.       "-----"
  452.       ("Frame Appearance"
  453.        ,@(if (featurep 'scrollbar)
  454.     '(["Scrollbars" (if (= (specifier-instance scrollbar-width) 0)
  455.              (progn
  456.                (set-specifier scrollbar-width 15)
  457.                (set-specifier scrollbar-height 15))
  458.                (set-specifier scrollbar-width 0)
  459.                (set-specifier scrollbar-height 0))
  460.     :style toggle :selected (> (specifier-instance scrollbar-width) 0)]))
  461.        ["3D Modeline"
  462.     (progn
  463.       (if (zerop (specifier-instance modeline-shadow-thickness))
  464.           (set-specifier modeline-shadow-thickness 2)
  465.         (set-specifier modeline-shadow-thickness 0))
  466.       (redraw-modeline t))
  467.     :style toggle :selected
  468.     (let ((thickness
  469.            (specifier-instance modeline-shadow-thickness)))
  470.       (and (integerp thickness)
  471.            (> thickness 0)))]
  472.        ["Truncate Lines" (progn
  473.                (setq truncate-lines (not truncate-lines))
  474.                (setq-default truncate-lines truncate-lines))
  475.     :style toggle :selected truncate-lines]
  476.        ["Bar Cursor" (progn
  477.                (setq bar-cursor
  478.                  (if (not bar-cursor) 2 nil))
  479.                (force-cursor-redisplay))
  480.     :style toggle :selected bar-cursor]
  481.        ["Blinking Cursor" (blink-cursor-mode)
  482.     :style toggle
  483.     :selected (and (boundp 'blink-cursor-mode) blink-cursor-mode)]
  484.        ["Frame-Local Font Menu" (setq font-menu-this-frame-only-p
  485.                     (not font-menu-this-frame-only-p))
  486.     :style toggle :selected font-menu-this-frame-only-p]
  487. ;     ["Line Numbers" (line-number-mode nil)
  488. ;      :style toggle :selected line-number-mode]
  489.       )
  490.       ("Menubar Appearance"
  491.        ["Buffers Menu Length..."
  492.     (progn
  493.       (setq buffers-menu-max-size
  494.         (read-number
  495.          "Enter number of buffers to display (or 0 for unlimited): "))
  496.       (if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
  497.     t]
  498.        ["Multi-Operation Buffers Sub-Menus"
  499.     (setq complex-buffers-menu-p
  500.           (not complex-buffers-menu-p))
  501.     :style toggle :selected complex-buffers-menu-p]
  502.        ("Buffers Menu Sorting"
  503.      ["Most Recently Used"
  504.       (progn
  505.         (setq buffers-menu-sort-function nil)
  506.         (setq buffers-menu-grouping-function nil))
  507.       :style radio
  508.       :selected (null buffers-menu-sort-function)]
  509.      ["Alphabetically"
  510.       (progn
  511.         (setq buffers-menu-sort-function
  512.           'sort-buffers-menu-alphabetically)
  513.         (setq buffers-menu-grouping-function nil))
  514.       :style radio
  515.       :selected (eq 'sort-buffers-menu-alphabetically
  516.             buffers-menu-sort-function)]
  517.      ["By Major Mode, Then Alphabetically"
  518.       (progn
  519.         (setq buffers-menu-sort-function
  520.           'sort-buffers-menu-by-mode-then-alphabetically)
  521.         (setq buffers-menu-grouping-function
  522.           'group-buffers-menu-by-mode-then-alphabetically))
  523.       :style radio
  524.       :selected (eq 'sort-buffers-menu-by-mode-then-alphabetically
  525.             buffers-menu-sort-function)])
  526.        ["Submenus for Buffer Groups"
  527.     (setq buffers-menu-submenus-for-groups-p
  528.           (not buffers-menu-submenus-for-groups-p))
  529.     :style toggle
  530.     :selected buffers-menu-submenus-for-groups-p
  531.     :active (not (null buffers-menu-grouping-function))]
  532.        "---"
  533.        ["Ignore Scaled Fonts" (setq font-menu-ignore-scaled-fonts
  534.                     (not font-menu-ignore-scaled-fonts))
  535.     :style toggle :selected font-menu-ignore-scaled-fonts]
  536.        )
  537.       ,@(if (featurep 'toolbar)
  538.     '(("Toolbar Appearance"
  539.        ["Visible" (set-specifier default-toolbar-visible-p
  540.                  (not (specifier-instance
  541.                        default-toolbar-visible-p)))
  542.     :style toggle
  543.     :selected (specifier-instance default-toolbar-visible-p)]
  544.        ["Captioned" (set-specifier toolbar-buttons-captioned-p
  545.                    (not (specifier-instance
  546.                      toolbar-buttons-captioned-p)))
  547.     :style toggle
  548.     :selected
  549.     (specifier-instance toolbar-buttons-captioned-p)]
  550.        ("Default Location"
  551.     ["Top" (set-default-toolbar-position 'top)
  552.      :style radio :selected (eq (default-toolbar-position) 'top)]
  553.     ["Bottom" (set-default-toolbar-position 'bottom)
  554.      :style radio :selected (eq (default-toolbar-position) 'bottom)]
  555.     ["Left" (set-default-toolbar-position 'left)
  556.      :style radio :selected (eq (default-toolbar-position) 'left)]
  557.     ["Right" (set-default-toolbar-position 'right)
  558.      :style radio :selected (eq (default-toolbar-position) 'right)]
  559.     )
  560.        )))
  561.       ("Mouse"
  562.        ["Avoid-Text"
  563.     (if (equal (device-type) 'x)
  564.         (if mouse-avoidance-mode
  565.         (mouse-avoidance-mode 'none)
  566.           (mouse-avoidance-mode 'banish))
  567.       (beep)
  568.       (message "This option requires a window system."))
  569.     :style toggle :selected (and mouse-avoidance-mode window-system)]
  570.        ["strokes-mode"
  571.     (if (equal (device-type) 'x)
  572.         (strokes-mode)
  573.       (beep)
  574.       (message "This option requires a window system."))
  575.     :style toggle :selected (and strokes-mode window-system)])
  576.       ("Open URLs With"
  577.        ["Emacs-W3" (setq browse-url-browser-function 'browse-url-w3)
  578.     :style radio
  579.     :selected (eq browse-url-browser-function 'browse-url-w3)]
  580.        ["Netscape" (setq browse-url-browser-function 'browse-url-netscape)
  581.     :style radio
  582.     :selected (eq browse-url-browser-function 'browse-url-netscape)]
  583.        ["Mosaic" (setq browse-url-browser-function 'browse-url-mosaic)
  584.     :style radio
  585.     :selected (eq browse-url-browser-function 'browse-url-mosaic)]
  586.        ["Mosaic (CCI)" (setq browse-url-browser-function 'browse-url-cci)
  587.     :style radio
  588.     :selected (eq browse-url-browser-function 'browse-url-iximosaic)]
  589.        ["IXI Mosaic" (setq browse-url-browser-function 'browse-url-iximosaic)
  590.     :style radio
  591.     :selected (eq browse-url-browser-function 'browse-url-iximosaic)]
  592.        ["Lynx (xterm)" (setq browse-url-browser-function 'browse-url-lynx-xterm)
  593.     :style radio
  594.     :selected (eq browse-url-browser-function 'browse-url-lynx-xterm)]
  595.        ["Lynx (xemacs)" (setq browse-url-browser-function 'browse-url-lynx-emacs)
  596.     :style radio
  597.     :selected (eq browse-url-browser-function 'browse-url-lynx-emacs)]
  598.        ["Grail" (setq browse-url-browser-function 'browse-url-grail)
  599.     :style radio
  600.     :selected (eq browse-url-browser-function 'browse-url-grail)]
  601.       )
  602.       "-----"
  603.       ["Browse Faces..." edit-faces t]
  604.       ("Font"   :filter font-menu-family-constructor)
  605.       ("Size"    :filter font-menu-size-constructor)
  606.       ("Weight"    :filter font-menu-weight-constructor)
  607.       "-----"
  608.       ["Save Options" save-options-menu-settings t]
  609.       )
  610.      
  611.      ("Buffers"
  612.       :filter buffers-menu-filter
  613.       ["List All Buffers" list-buffers t]
  614.       "--"
  615.       )
  616.      
  617.      ("Tools"
  618.       ["Grep..."        grep            t]
  619.       ["Compile..."        compile            t]
  620.       ["Shell"            shell            t]
  621.       ["Shell Command..."    shell-command        t]
  622.       ["Shell Command on Region..." shell-command-on-region (region-exists-p)]
  623.       ["Debug (GDB)..."        gdb            t]
  624.       ["Debug (DBX)..."        dbx            t]
  625.       "-----"
  626.       ("Tags"
  627.        ["Find Tag..."        find-tag        t]
  628.        ["Find Other Window..."    find-tag-other-window    t]
  629.        ["Next Tag..."        (find-tag nil)        t]
  630.        ["Next Other Window..."    (find-tag-other-window nil) t]
  631.        ["Next File"        next-file        t]
  632.        "-----"
  633.        ["Tags Search..."    tags-search        t]
  634.        ["Tags Replace..."    tags-query-replace    t]
  635.        ["Continue Search/Replace" tags-loop-continue    t]
  636.        "-----"
  637.        ["Pop stack"        pop-tag-mark        t]
  638.        ["Apropos..."        tags-apropos        t]
  639.        "-----"
  640.        ["Set Tags Table File..." visit-tags-table    t]
  641.        ))
  642.  
  643.      nil        ; the partition: menus after this are flushright
  644.  
  645.      ("Help"
  646.       ["About XEmacs..."    about-xemacs        t]
  647.       ("Basics"
  648.        ["Tutorial"        help-with-tutorial    t]
  649.        ["News"            view-emacs-news        t]
  650.        ["Packages"        finder-by-keyword    t]
  651.        ["Splash"        xemacs-splash-buffer    t])
  652.       "-----"
  653.       ("XEmacs FAQ"
  654.        ["FAQ (local)"        xemacs-local-faq    t]
  655.        ["FAQ via WWW"         xemacs-www-faq    t]
  656.        ["Home Page"        xemacs-www-page        t])
  657.       ("Samples"
  658.        ["Sample"            (find-file
  659.                      (expand-file-name "sample.emacs"
  660.                                data-directory))
  661.     t ".emacs"]
  662.        ["Sample"            (find-file
  663.                      (expand-file-name "sample.Xdefaults"
  664.                                data-directory))
  665.     t ".Xdefaults"]
  666.        ["Sample"            (find-file
  667.                      (expand-file-name "enriched.doc"
  668.                                data-directory))
  669.     t "enriched"])
  670.       "-----"
  671.       ("Lookup in Info"
  672.        ["Key Binding..."    Info-goto-emacs-key-command-node t]
  673.        ["Command..."        Info-goto-emacs-command-node t]
  674.        ["Function..."        Info-elisp-ref        t]
  675.        ["Topic..."        Info-query        t])
  676.       ("Manuals"
  677.        ["Info"            info            t]
  678.        ["Unix Manual..."    manual-entry        t])
  679.       ("Commands & Keys"
  680.        ["Mode"            describe-mode        t]
  681.        ["Apropos..."        hyper-apropos        t]
  682.        ["Apropos Docs..."    apropos-documentation    t]
  683.        "-----"
  684.        ["Key..."        describe-key        t]
  685.        ["Bindings"        describe-bindings    t]
  686.        ["Mouse Bindings"    describe-pointer    t]
  687.        ["Recent Keys"        view-lossage        t]
  688.        "-----"
  689.        ["Function..."        describe-function    t]
  690.        ["Variable..."        describe-variable    t]
  691.        ["Locate Command..."    where-is        t])
  692.       "-----"
  693.       ["Recent Messages"    view-lossage        t]
  694.       ("Misc"
  695.        ["No Warranty"        describe-no-warranty    t]
  696.        ["XEmacs License"    describe-copying    t]
  697.        ["The Latest Version"    describe-distribution    t])
  698.       ["Submit Bug Report"    send-pr            t]
  699.       )
  700.      )))
  701.  
  702.  
  703. (defun maybe-add-init-button ()
  704.   "Don't call this.
  705. Adds `Load .emacs' button to menubar when starting up with -q."
  706.   ;; by Stig@hackvan.com
  707.   (cond
  708.    (init-file-user nil)
  709.    ((file-exists-p (cond 
  710.             ((eq system-type 'ms-dos)
  711.              (concat "~" (user-login-name) "/_emacs"))
  712.             ((eq system-type 'vax-vms) 
  713.              "sys$login:.emacs")
  714.             (t 
  715.              (concat "~" (user-login-name) "/.emacs"))))
  716.     (add-menu-button nil
  717.              ["Load .emacs"
  718.               (progn (delete-menu-item '("Load .emacs"))
  719.                  (load-user-init-file (user-login-name)))
  720.               t]
  721.              "Help"))
  722.    (t nil)))
  723.  
  724. (add-hook 'before-init-hook 'maybe-add-init-button)
  725.  
  726.  
  727. ;;; The File and Edit menus
  728.  
  729. (defvar put-buffer-names-in-file-menu t)
  730.  
  731. ;; The sensitivity part of this function could be done by just adding forms
  732. ;; to evaluate to the menu items themselves; that would be marginally less
  733. ;; efficient but not perceptibly so (I think).  But in order to change the
  734. ;; names of the Undo menu item and the various things on the File menu item,
  735. ;; we need to use a hook.
  736.  
  737. (defun file-menu-filter (menu-items)
  738.   "Incrementally update the file menu.
  739. This function changes the arguments and sensitivity of these File menu items:
  740.  
  741.   Delete Buffer  has the name of the current buffer appended to it.
  742.   Print Buffer   has the name of the current buffer appended to it.
  743.   Pretty-Print Buffer
  744.          has the name of the current buffer appended to it.
  745.   Save           has the name of the current buffer appended to it, and is
  746.                  sensitive only when the current buffer is modified.
  747.   Revert Buffer  has the name of the current buffer appended to it, and is
  748.                  sensitive only when the current buffer has a file.
  749.   Delete Frame   sensitive only when there is more than one frame.
  750.  
  751. The name of the current buffer is only appended to the menu items if
  752. `put-buffer-names-in-file-menu' is non-nil.  This behavior is the default."
  753.   (let* ((bufname (buffer-name))
  754.      (result menu-items)        ; save pointer to start of menu.
  755.      name
  756.      item)
  757.     ;; the contents of the menu items in the file menu are destructively
  758.     ;; modified so that there is as little consing as possible.  This is okay.
  759.     ;; As soon as the result is returned, it is converted to widget_values
  760.     ;; inside lwlib and the lisp menu-items can be safely modified again. 
  761.     (while (setq item (pop menu-items))
  762.       (if (vectorp item)
  763.       (progn
  764.         (setq name (aref item 0))
  765.         (and put-buffer-names-in-file-menu
  766.          (member name '("Save" "Revert Buffer" "Print Buffer"
  767.                 "Pretty-Print Buffer" "Delete Buffer"))
  768.          (>= (length item) 4)
  769.          (aset item 3 bufname))
  770.         (and (string= "Save" name)
  771.          (aset item 2 (buffer-modified-p)))
  772.         (and (string= "Revert Buffer" name)
  773.          (aset item 2 (not (not (or buffer-file-name
  774.                         revert-buffer-function)))))
  775.         (and (string= "Delete Frame" name)
  776.          (aset item 2 (not (eq (next-frame (selected-frame)
  777.                            'nomini 'window-system)
  778.                        (selected-frame)))))
  779.         )))
  780.     result))
  781.  
  782. (defun edit-menu-filter (menu-items)
  783.   "For use as an incremental menu construction filter.
  784. This function changes the sensitivity of these Edit menu items:
  785.  
  786.   Cut    sensitive only when emacs owns the primary X Selection.
  787.   Copy   sensitive only when emacs owns the primary X Selection.
  788.   Clear  sensitive only when emacs owns the primary X Selection.
  789.   Paste  sensitive only when there is an owner for the X Clipboard Selection.
  790.   Undo   sensitive only when there is undo information.
  791.          While in the midst of an undo, this is changed to \"Undo More\"."
  792.   (let* (item
  793.     name
  794.     (result menu-items)        ; save pointer to head of list
  795.     (x-dev (eq 'x (device-type (selected-device))))
  796.     (emacs-owns-selection-p (and x-dev (x-selection-owner-p)))
  797.     (clipboard-exists-p (and x-dev (x-selection-exists-p 'CLIPBOARD)))
  798. ;;;       undo-available undoing-more
  799. ;;;       (undo-info-available (not (null (and (not (eq t buffer-undo-list))
  800. ;;;                                 (if (eq last-command 'undo)
  801. ;;;                                     (setq undoing-more
  802. ;;;                                           (and (boundp 'pending-undo-list)
  803. ;;;                                          pending-undo-list)
  804. ;;;                                   buffer-undo-list))))))
  805.     undo-name undo-state
  806.     )
  807.     ;; As with file-menu-filter, menu-items are destructively modified.
  808.     ;; This is OK.
  809.     (while (setq item (pop menu-items))
  810.       (if (vectorp item)
  811.       (progn
  812.         (setq name (aref item 0))
  813.         (and (member name '("Cut" "Copy" "Clear"))
  814.          (aset item 2 emacs-owns-selection-p))
  815.         (and (string= name "Paste")
  816.          (aset item 2 clipboard-exists-p))
  817.         (and (member name '("Undo" "Undo More"))
  818.          (progn
  819.            ;; we could also do this with the third field of the item.
  820.            (if (eq last-command 'undo)
  821.                (setq undo-name "Undo More"
  822.                  undo-state (not (null (and (boundp 'pending-undo-list)
  823.                             pending-undo-list))))
  824.              (setq undo-name "Undo"
  825.                undo-state (and (not (eq buffer-undo-list t))
  826.                        (not (null
  827.                          (or buffer-undo-list
  828.                              (and (boundp 'pending-undo-list)
  829.                               pending-undo-list)))))))
  830.            (if buffer-read-only (setq undo-state nil))
  831.            (aset item 0 undo-name)
  832.            (aset item 2 undo-state)
  833.            ))
  834.       )))
  835.     result))
  836.  
  837.  
  838. ;;; The Bookmarks menu
  839.  
  840. (defun bookmark-menu-filter (menu-items)
  841.   "*Build the bookmark jump submenu dynamically from all defined bookmarks."
  842.   (if (bookmark-all-names)
  843.       (mapcar
  844.        #'(lambda (bmk)
  845.        (vector bmk `(bookmark-jump ',bmk) t)) (bookmark-all-names))
  846.     '(["No Bookmarks Set" nil nil])))
  847.  
  848. (defun bookmark-delete-filter (menu-items)
  849.   "*Build the bookmark delete submenu dynamically from all defined bookmarks."
  850.   (if (bookmark-all-names)
  851.       (mapcar
  852.        #'(lambda (bmk)
  853.        (vector bmk `(bookmark-delete ',bmk) t)) (bookmark-all-names))
  854.     '(["No Bookmarks Set" nil nil])))
  855.  
  856. ;;; The Buffers menu
  857.  
  858. (defgroup buffers-menu nil
  859.   "Customization of `Buffers' menu."
  860.   :group 'menu)
  861.  
  862. (defcustom buffers-menu-max-size 25
  863.   "*Maximum number of entries which may appear on the \"Buffers\" menu.
  864. If this is 10, then only the ten most-recently-selected buffers will be
  865. shown.  If this is nil, then all buffers will be shown.  Setting this to
  866. a large number or nil will slow down menu responsiveness."
  867.   :type '(choice (const :tag "Show all" nil)
  868.          (integer 10))
  869.   :group 'buffers-menu)
  870.  
  871. (defcustom complex-buffers-menu-p nil
  872.   "*If non-nil, the buffers menu will contain several commands.
  873. Commands will be presented as submenus of each buffer line.  If this
  874. is false, then there will be only one command: select that buffer."
  875.   :type 'boolean
  876.   :group 'buffers-menu)
  877.  
  878. (defcustom buffers-menu-submenus-for-groups-p nil
  879.   "*If non-nil, the buffers menu will contain one submenu per group of buffers.
  880. The grouping function is specified in `buffers-menu-grouping-function'.
  881. If this is an integer, do not build submenus if the number of buffers
  882. is not larger than this value."
  883.   :type '(choice (const :tag "No Subgroups" nil)
  884.          (integer :tag "Max. submenus" 10)
  885.          (sexp :format "%t\n" :tag "Allow Subgroups"))
  886.   :group 'buffers-menu)
  887.  
  888. (defcustom buffers-menu-switch-to-buffer-function 'switch-to-buffer
  889.   "*The function to call to select a buffer from the buffers menu.
  890. `switch-to-buffer' is a good choice, as is `pop-to-buffer'."
  891.   :type '(radio (function-item switch-to-buffer)
  892.         (function-item pop-to-buffer)
  893.         (function :tag "Other"))
  894.   :group 'buffers-menu)
  895.  
  896. (defcustom buffers-menu-omit-function 'buffers-menu-omit-invisible-buffers
  897.   "*If non-nil, a function specifying the buffers to omit from the buffers menu.
  898. This is passed a buffer and should return non-nil if the buffer should be
  899. omitted.  The default value `buffers-menu-omit-invisible-buffers' omits
  900. buffers that are normally considered \"invisible\" (those whose name
  901. begins with a space)."
  902.   :type '(choice (const :tag "None" nil)
  903.          function)
  904.   :group 'buffers-menu)
  905.  
  906. (defcustom buffers-menu-format-buffer-line-function 'format-buffers-menu-line
  907.   "*The function to call to return a string to represent a buffer in the
  908. buffers menu.  The function is passed a buffer and should return a string.
  909. The default value `format-buffers-menu-line' just returns the name of
  910. the buffer.  Also check out `slow-format-buffers-menu-line' which
  911. returns a whole bunch of info about a buffer."
  912.   :type 'function
  913.   :group 'buffers-menu)
  914.  
  915. (defcustom buffers-menu-sort-function
  916.   'sort-buffers-menu-by-mode-then-alphabetically
  917.   "*If non-nil, a function to sort the list of buffers in the buffers menu.
  918. It will be passed two arguments (two buffers to compare) and should return
  919. T if the first is \"less\" than the second.  One possible value is
  920. `sort-buffers-menu-alphabetically'; another is
  921. `sort-buffers-menu-by-mode-then-alphabetically'."
  922.   :type '(choice (const :tag "None" nil)
  923.          function)
  924.   :group 'buffers-menu)
  925.  
  926. (defcustom buffers-menu-grouping-function
  927.   'group-buffers-menu-by-mode-then-alphabetically
  928.   "*If non-nil, a function to group buffers in the buffers menu together.
  929. It will be passed two arguments, successive members of the sorted buffers
  930. list after being passed through `buffers-menu-sort-function'.  It should
  931. return non-nil if the second buffer begins a new group.  The return value
  932. should be the name of the old group, which may be used in hierarchical
  933. buffers menus.  The last invocation of the function contains nil as the
  934. second argument, so that the name of the last group can be determined.
  935.  
  936. The sensible values of this function are dependent on the value specified
  937. for `buffers-menu-sort-function'."
  938.   :type '(choice (const :tag "None" nil)
  939.          function)
  940.   :group 'buffers-menu)
  941.  
  942. (defun buffers-menu-omit-invisible-buffers (buf)
  943.   "For use as a value of `buffers-menu-omit-function'.
  944. Omits normally invisible buffers (those whose name begins with a space)."
  945.   (not (null (string-match "\\` " (buffer-name buf)))))
  946.  
  947. (defun sort-buffers-menu-alphabetically (buf1 buf2)
  948.   "For use as a value of `buffers-menu-sort-function'.
  949. Sorts the buffers in alphabetical order by name, but puts buffers beginning
  950. with a star at the end of the list."
  951.   (let* ((nam1 (buffer-name buf1))
  952.      (nam2 (buffer-name buf2))
  953.      (star1p (not (null (string-match "\\`*" nam1))))
  954.      (star2p (not (null (string-match "\\`*" nam2)))))
  955.     (if (not (eq star1p star2p))
  956.     (not star1p)
  957.       (string-lessp nam1 nam2))))
  958.  
  959. (defun sort-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
  960.   "For use as a value of `buffers-menu-sort-function'.
  961. Sorts first by major mode and then alphabetically by name, but puts buffers
  962. beginning with a star at the end of the list."
  963.   (let* ((nam1 (buffer-name buf1))
  964.      (nam2 (buffer-name buf2))
  965.      (star1p (not (null (string-match "\\`*" nam1))))
  966.      (star2p (not (null (string-match "\\`*" nam2))))
  967.      (mode1 (symbol-value-in-buffer 'major-mode buf1))
  968.      (mode2 (symbol-value-in-buffer 'major-mode buf2)))
  969.     (cond ((not (eq star1p star2p)) (not star1p))
  970.       ((and star1p star2p (string-lessp nam1 nam2)))
  971.       ((string-lessp mode1 mode2) t)
  972.       ((string-lessp mode2 mode1) nil)
  973.       (t (string-lessp nam1 nam2)))))
  974.  
  975. ;; this version is too slow on some machines.
  976. (defun slow-format-buffers-menu-line (buffer)
  977.   "For use as a value of `buffers-menu-format-buffer-line-function'.
  978. This returns a string containing a bunch of info about the buffer."
  979.   (format "%s%s %-19s %6s %-15s %s"
  980.       (if (buffer-modified-p buffer) "*" " ")
  981.       (if (symbol-value-in-buffer 'buffer-read-only buffer) "%" " ")
  982.       (buffer-name buffer)
  983.       (buffer-size buffer)
  984.       (symbol-value-in-buffer 'mode-name buffer)
  985.       (or (buffer-file-name buffer) "")))
  986.  
  987. (defun format-buffers-menu-line (buffer)
  988.   "For use as a value of `buffers-menu-format-buffer-line-function'.
  989. This just returns the buffer's name."
  990.   (buffer-name buffer))
  991.  
  992. (defun group-buffers-menu-by-mode-then-alphabetically (buf1 buf2)
  993.   "For use as a value of `buffers-menu-grouping-function'.
  994. This groups buffers by major mode.  It only really makes sense if
  995. `buffers-menu-sorting-function' is
  996. `sort-buffers-menu-by-mode-then-alphabetically'."
  997.   (cond ((string-match "\\`*" (buffer-name buf1))
  998.      (and (null buf2) "*Misc*"))
  999.     ((or (null buf2)
  1000.          (string-match "\\`*" (buffer-name buf2))
  1001.          (not (eq (symbol-value-in-buffer 'major-mode buf1)
  1002.               (symbol-value-in-buffer 'major-mode buf2))))
  1003.      (symbol-value-in-buffer 'mode-name buf1))
  1004.     (t nil)))
  1005.  
  1006. (defun buffer-menu-save-buffer (buffer)
  1007.   (save-excursion
  1008.     (set-buffer buffer)
  1009.     (save-buffer)))
  1010.  
  1011. (defun buffer-menu-write-file (buffer)
  1012.   (save-excursion
  1013.     (set-buffer buffer)
  1014.     (write-file (read-file-name
  1015.          (format "Write %s to file: "
  1016.              (buffer-name (current-buffer)))))))
  1017.  
  1018. (defsubst build-buffers-menu-internal (buffers)
  1019.   (let (name line)
  1020.     (mapcar
  1021.      #'(lambda (buffer)
  1022.      (if (eq buffer t)
  1023.          "---"
  1024.        (setq line (funcall buffers-menu-format-buffer-line-function
  1025.                    buffer))
  1026.        (if complex-buffers-menu-p
  1027.            (delq nil
  1028.              (list line
  1029.                (vector "Switch to Buffer"
  1030.                    (list buffers-menu-switch-to-buffer-function
  1031.                      (setq name (buffer-name buffer)))
  1032.                    t)
  1033.                (if (eq buffers-menu-switch-to-buffer-function
  1034.                    'switch-to-buffer)
  1035.                    (vector "Switch to Buffer, Other Frame"
  1036.                        (list 'switch-to-buffer-other-frame
  1037.                          (setq name (buffer-name buffer)))
  1038.                        t)
  1039.                  nil)
  1040.                (if (and (buffer-modified-p buffer)
  1041.                     (buffer-file-name buffer))
  1042.                    (vector "Save Buffer"
  1043.                        (list 'buffer-menu-save-buffer name) t)
  1044.                  ["Save Buffer" nil nil]
  1045.                  )
  1046.                (vector "Save As..."
  1047.                    (list 'buffer-menu-write-file name) t)
  1048.                (vector "Delete Buffer" (list 'kill-buffer name)
  1049.                    t)))
  1050.          ;; ### We don't want buffer names to be translated,
  1051.          ;; ### so we put the buffer name in the suffix.
  1052.          ;; ### Also, avoid losing with non-ASCII buffer names.
  1053.          ;; ### We still lose, however, if complex-buffers-menu-p. --mrb
  1054.          (vector ""
  1055.              (list buffers-menu-switch-to-buffer-function
  1056.                (buffer-name buffer))
  1057.              t line))))
  1058.      buffers)))
  1059.  
  1060. (defun buffers-menu-filter (menu)
  1061.   "This is the menu filter for the top-level buffers \"Buffers\" menu.
  1062. It dynamically creates a list of buffers to use as the contents of the menu.
  1063. Only the most-recently-used few buffers will be listed on the menu, for
  1064. efficiency reasons.  You can control how many buffers will be shown by
  1065. setting `buffers-menu-max-size'.  You can control the text of the menu
  1066. items by redefining the function `format-buffers-menu-line'."
  1067.   (let ((buffers (delete-if buffers-menu-omit-function (buffer-list))))
  1068.     (and (integerp buffers-menu-max-size)
  1069.      (> buffers-menu-max-size 1)
  1070.      (> (length buffers) buffers-menu-max-size)
  1071.      ;; shorten list of buffers (not with submenus!)
  1072.      (not (and buffers-menu-grouping-function
  1073.            buffers-menu-submenus-for-groups-p))
  1074.      (setcdr (nthcdr buffers-menu-max-size buffers) nil))
  1075.     (if buffers-menu-sort-function
  1076.     (setq buffers (sort buffers buffers-menu-sort-function)))
  1077.     (if (and buffers-menu-grouping-function
  1078.          buffers-menu-submenus-for-groups-p
  1079.          (or (not (integerp buffers-menu-submenus-for-groups-p))
  1080.          (> (length buffers) buffers-menu-submenus-for-groups-p)))
  1081.     (let (groups groupnames current-group)
  1082.       (mapl
  1083.        #'(lambda (sublist)
  1084.            (let ((groupname (funcall buffers-menu-grouping-function
  1085.                      (car sublist) (cadr sublist))))
  1086.          (setq current-group (cons (car sublist) current-group))
  1087.          (if groupname
  1088.              (progn
  1089.                (setq groups (cons (nreverse current-group)
  1090.                       groups))
  1091.                (setq groupnames (cons groupname groupnames))
  1092.                (setq current-group nil)))))
  1093.        buffers)
  1094.       (setq buffers
  1095.         (mapcar*
  1096.          #'(lambda (groupname group)
  1097.              (cons groupname (build-buffers-menu-internal group)))
  1098.          (nreverse groupnames)
  1099.          (nreverse groups))))
  1100.       (if buffers-menu-grouping-function
  1101.       (progn
  1102.         (setq buffers
  1103.           (mapcon
  1104.            #'(lambda (sublist)
  1105.                (cond ((funcall buffers-menu-grouping-function
  1106.                        (car sublist) (cadr sublist))
  1107.                   (list (car sublist) t))
  1108.                  (t (list (car sublist)))))
  1109.            buffers))
  1110.         ;; remove a trailing separator.
  1111.         (and (>= (length buffers) 2)
  1112.          (let ((lastcdr (nthcdr (- (length buffers) 2) buffers)))
  1113.            (if (eq t (cadr lastcdr))
  1114.                (setcdr lastcdr nil))))))
  1115.       (setq buffers (build-buffers-menu-internal buffers)))
  1116.     (append menu buffers)
  1117.     ))
  1118.  
  1119. (defun language-environment-menu-filter (menu)
  1120.   "This is the menu filter for the \"Language Environment\" submenu."
  1121.   (mapcar (lambda (env-sym)
  1122.         `[ ,(capitalize (symbol-name env-sym))
  1123.            (set-language-environment ',env-sym) t])
  1124.       language-environment-list))
  1125.  
  1126.  
  1127. ;;; The Options menu
  1128.  
  1129. (defvar options-save-faces nil
  1130.   "if t, save-options will save all the face information.
  1131. Set to nil to avoid this. This is recommended on XEmacs 19.15
  1132. and above as we have a much more powerful (read: working) way 
  1133. of changing and saving faces via cu-edit-faces.el & custom.el.")
  1134.  
  1135. (defconst options-menu-saved-forms
  1136.   ;; This is really quite a kludge, but it gets the job done.
  1137.   ;;
  1138.   ;; remember that we have to conditionalize on default features
  1139.   ;; both in the forms to evaluate and in the forms output to
  1140.   ;; .emacs, in case the .emacs is loaded into an XEmacs with
  1141.   ;; different features.
  1142.   (purecopy
  1143.    '(
  1144.      ;; Editing Options menu.
  1145.      ;; put case-fold-search first to defeat a bug in the backquote
  1146.      ;; processing mechanism.  Feh!
  1147.      case-fold-search
  1148.      `(setq-default overwrite-mode ,(default-value 'overwrite-mode))
  1149.      (if (default-value 'overwrite-mode)
  1150.      '(overwrite-mode 1))
  1151.      `(setq-default case-fold-search ,(default-value 'case-fold-search))
  1152.      case-replace
  1153.      (if (and (boundp 'pending-delete-mode)
  1154.           pending-delete-mode)
  1155.      '(pending-delete-mode 1))
  1156.      zmacs-regions
  1157.      mouse-yank-at-point
  1158.      require-final-newline
  1159.      next-line-add-newlines
  1160.  
  1161.      ;; General Options menu.
  1162.      teach-extended-commands-p
  1163.      ;; (#### not actually on Options menu)
  1164.      teach-extended-commands-timeout
  1165.      debug-on-error
  1166.      debug-on-quit
  1167.  
  1168.      ;; Printing Options menu.
  1169.      lpr-switches
  1170.      ps-print-color-p
  1171.      ps-paper-type
  1172.  
  1173.      ;; Other Window Location
  1174.      get-frame-for-buffer-default-instance-limit
  1175.      temp-buffer-show-function
  1176.      (if gnuserv-frame
  1177.      '(setq gnuserv-frame (selected-frame)))
  1178.  
  1179.      ;; Syntax Highlighting
  1180.      font-lock-auto-fontify
  1181.      font-lock-use-fonts
  1182.      font-lock-use-colors
  1183.      font-lock-maximum-decoration
  1184.      font-lock-maximum-size
  1185.      ;; (#### the next two not on Options menu)
  1186.      font-lock-mode-enable-list
  1187.      font-lock-mode-disable-list
  1188.      ;; #### - this structure is clearly broken.  There's no way to ever
  1189.      ;; un-require font-lock via the menus.  --Stig
  1190.      (if (featurep 'font-lock)
  1191.      '(require 'font-lock))
  1192.      (if (and (boundp 'font-lock-mode-hook)
  1193.           (memq 'turn-on-fast-lock font-lock-mode-hook))
  1194.      '(add-hook 'font-lock-mode-hook 'turn-on-fast-lock)
  1195.        '(remove-hook 'font-lock-mode-hook 'turn-on-fast-lock))
  1196.      (if (and (boundp 'font-lock-mode-hook)
  1197.           (memq 'turn-on-lazy-shot font-lock-mode-hook))
  1198.      '(add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
  1199.        '(remove-hook 'font-lock-mode-hook 'turn-on-lazy-shot))
  1200.  
  1201.      ;; Paren Highlighting
  1202.      (if paren-mode
  1203.       `(progn (require 'paren) (paren-set-mode ',paren-mode)))
  1204.  
  1205.      ;; For specifiers, we only save global settings since the others
  1206.      ;; will belong to objects which only exist during this session.
  1207.  
  1208.      ;; Frame Appearance
  1209.      (if (featurep 'scrollbar)
  1210.      `(if (featurep 'scrollbar)
  1211.           (progn
  1212.         (add-spec-list-to-specifier
  1213.          scrollbar-width
  1214.          ',(specifier-spec-list scrollbar-width 'global))
  1215.         (add-spec-list-to-specifier
  1216.          scrollbar-height
  1217.          ',(specifier-spec-list scrollbar-height 'global)))))
  1218.      `(add-spec-list-to-specifier
  1219.        modeline-shadow-thickness
  1220.        ',(specifier-spec-list modeline-shadow-thickness 'global))
  1221.      `(setq-default truncate-lines ,(default-value 'truncate-lines))
  1222.      bar-cursor
  1223.      (if (and (boundp 'blink-cursor-mode) blink-cursor-mode)
  1224.      '(blink-cursor-mode t))
  1225.  
  1226.      ;; Menubar Appearance
  1227.      buffers-menu-max-size
  1228.      complex-buffers-menu-p
  1229.      buffers-menu-sort-function
  1230.      buffers-menu-grouping-function
  1231.      buffers-menu-submenus-for-groups-p
  1232.      font-menu-ignore-scaled-fonts
  1233.      font-menu-this-frame-only-p
  1234.  
  1235.      ;; Toolbar Appearance
  1236.      (if (featurep 'toolbar)
  1237.      `(if (featurep 'toolbar)
  1238.           (progn
  1239.         (set-default-toolbar-position
  1240.          ',(default-toolbar-position))
  1241.         (add-spec-list-to-specifier
  1242.          default-toolbar-visible-p
  1243.          ',(specifier-spec-list default-toolbar-visible-p 'global))
  1244.         (add-spec-list-to-specifier
  1245.          toolbar-buttons-captioned-p
  1246.          ',(specifier-spec-list toolbar-buttons-captioned-p
  1247.                     'global)))))
  1248.  
  1249.      ;; mouse
  1250.      mouse-avoidance-mode
  1251.  
  1252.      ;; Open URLs With
  1253.      browse-url-browser-function
  1254.  
  1255.      ;; Now save all faces.
  1256.  
  1257.      ;; Setting this in lisp conflicts with X resources.  Bad move.  --Stig 
  1258.      ;; (list 'set-face-font ''default (face-font-name 'default))
  1259.      ;; (list 'set-face-font ''modeline (face-font-name 'modeline))
  1260.      (if options-save-faces
  1261.      (cons 'progn
  1262.            (mapcar #'(lambda (face)
  1263.                `(make-face ',face))
  1264.                (save-options-non-customized-face-list))))
  1265.  
  1266.      (if options-save-faces
  1267.      (cons 'progn
  1268.            (apply 'nconc
  1269.               (mapcar
  1270.                #'(lambda (face)
  1271.                (delq nil
  1272.                  (mapcar
  1273.                   #'(lambda (property)
  1274.                       (if (specifier-spec-list
  1275.                        (face-property face property))
  1276.                       `(add-spec-list-to-specifier
  1277.                         (face-property ',face ',property)
  1278.                         ',(save-options-specifier-spec-list
  1279.                            face property))))
  1280.                   (delq 'display-table
  1281.                     (copy-sequence
  1282.                      built-in-face-specifiers)))))
  1283.                (save-options-non-customized-face-list)))))
  1284.  
  1285.      ;; Mule-specific:
  1286.      (if (featurep 'mule)
  1287.      `(if (featurep 'mule)
  1288.           (set-language-environment ',current-language-environment)))
  1289.      ))
  1290.   "The variables to save; or forms to evaluate to get forms to write out.
  1291. This is used by `save-options-menu-settings' and should mirror the
  1292. options listed in the Options menu.")
  1293.  
  1294. (defun save-options-non-customized-face-list ()
  1295.   "This function will return a list of all faces that have not been
  1296. 'customized'."
  1297.   (delq nil (mapcar '(lambda (face)
  1298.                (unless (get face 'saved-face)
  1299.              face))
  1300.             (face-list))))
  1301.  
  1302. (defun save-options-specifier-spec-list (face property)
  1303.   (if (not (or (eq property 'font) (eq property 'color)))
  1304.       (specifier-spec-list (face-property face property) 'global)
  1305.     (let* ((retlist (specifier-spec-list (face-property face property)
  1306.                      'global))
  1307.        (entry (cdr (car retlist)))
  1308.        item)
  1309.       (while entry
  1310.     (setq item (car entry))
  1311.     (if (eq property 'font)
  1312.         (if (font-instance-p (cdr item))
  1313.         (setcdr item (font-instance-name (cdr item))))
  1314.       (if (color-instance-p (cdr item))
  1315.           (setcdr item (color-instance-name (cdr item)))))
  1316.     (setq entry (cdr entry)))
  1317.       retlist)))
  1318.  
  1319. (defvar save-options-init-file nil
  1320.   "File into which to save forms to load the options file (nil for .emacs).
  1321. Normally this is nil, which means save into your .emacs file (the value
  1322. of `user-init-file'.")
  1323.  
  1324. (defvar save-options-file ".xemacs-options"
  1325.   "File to save options into.
  1326. This file is loaded from your .emacs file.
  1327. If this is a relative filename, it is put into the same directory as your
  1328. .emacs file.")
  1329.  
  1330. (defun save-options-menu-settings ()
  1331.   "Saves the current settings of the `Options' menu to your `.emacs' file."
  1332.   (interactive)
  1333.   ;; we compute the actual filenames now because x-menubar is loaded
  1334.   ;; at dump time, when the identity of the user running XEmacs is not known.
  1335.   (let* ((actual-save-options-init-file
  1336.       (or save-options-init-file
  1337.           (and (not (equal user-init-file ""))
  1338.            user-init-file)
  1339.           (and (eq system-type 'ms-dos)
  1340.            (concat "~" (user-login-name) "/_emacs"))
  1341.           (concat "~" (user-login-name) "/.emacs")))
  1342.      (actual-save-options-file
  1343.       (abbreviate-file-name
  1344.        (expand-file-name
  1345.         save-options-file
  1346.         (file-name-directory actual-save-options-init-file))
  1347.        ;; Don't hack-homedir in abbreviate-file-name.  This will
  1348.        ;; cause an incorrect expansion if the save-options variables
  1349.        ;; have ~ in them.
  1350.        ))
  1351.      (init-output-buffer (find-file-noselect
  1352.                   actual-save-options-init-file))
  1353.      init-output-marker
  1354.      (options-output-buffer
  1355.       (find-file-noselect actual-save-options-file))
  1356.      options-output-marker)
  1357.  
  1358.     (save-excursion
  1359.       (set-buffer options-output-buffer)
  1360.       (erase-buffer)
  1361.       (setq options-output-marker (point-marker)))
  1362.  
  1363.     ;; run with current-buffer unchanged so that variables are evaluated in
  1364.     ;; the current context, instead of in the context of the ".emacs" buffer
  1365.     ;; or the ".xemacs-options" buffer.
  1366.  
  1367.     ;; first write out .xemacs-options.
  1368.  
  1369.     (let ((standard-output options-output-marker))
  1370.       (princ ";; -*- Mode: Emacs-Lisp -*-\n\n")
  1371.       (princ "(setq options-file-xemacs-version '(")
  1372.       (princ emacs-major-version)
  1373.       (princ " ")
  1374.       (princ emacs-minor-version)
  1375.       (princ "))\n")
  1376.       (let ((print-readably t)
  1377.         (print-escape-newlines t))
  1378.     (mapcar #'(lambda (var)
  1379.             (princ "  ")
  1380.             (if (symbolp var)
  1381.             (prin1 (list 'setq-default var
  1382.                      (let ((val (symbol-value var)))
  1383.                        (if (or (memq val '(t nil))
  1384.                            (and (not (symbolp val))
  1385.                             (not (consp val))))
  1386.                        val
  1387.                      (list 'quote val)))))
  1388.               (setq var (eval var))
  1389.               (cond ((eq (car-safe var) 'progn)
  1390.                  (while (setq var (cdr var))
  1391.                    (prin1 (car var))
  1392.                    (princ "\n")
  1393.                    (if (cdr var) (princ "  "))
  1394.                    ))
  1395.                 (var
  1396.                  (prin1 var))))
  1397.             (if var (princ "\n")))
  1398.         options-menu-saved-forms)
  1399.     ))
  1400.     (set-marker options-output-marker nil)
  1401.     (save-excursion
  1402.       (set-buffer options-output-buffer)
  1403.       (save-buffer))
  1404.  
  1405.     ;; then fix .emacs.
  1406.  
  1407.     (save-excursion
  1408.       (set-buffer init-output-buffer)
  1409.       ;;
  1410.       ;; Find and delete the previously saved data, and position to write.
  1411.       ;;
  1412.       (goto-char (point-min))
  1413.       (if (re-search-forward "^;; Options Menu Settings *\n" nil 'move)
  1414.       (let ((p (match-beginning 0)))
  1415.         (goto-char p)
  1416.         (or (re-search-forward
  1417.          "^;; End of Options Menu Settings *\\(\n\\|\\'\\)"
  1418.          nil t)
  1419.         (error "can't find END of saved state in .emacs"))
  1420.         (delete-region p (match-end 0)))
  1421.     (goto-char (point-max))
  1422.     (insert "\n"))
  1423.       (setq init-output-marker (point-marker)))
  1424.  
  1425.     (let ((standard-output init-output-marker))
  1426.       (princ ";; Options Menu Settings\n")
  1427.       (princ ";; =====================\n")
  1428.       (princ "(cond\n")
  1429.       (princ " ((and (string-match \"XEmacs\" emacs-version)\n")
  1430.       (princ "       (boundp 'emacs-major-version)\n")
  1431.       (princ "       (or (and\n")
  1432.       (princ "            (= emacs-major-version 19)\n")
  1433.       (princ "            (>= emacs-minor-version 14))\n")
  1434.       (princ "           (= emacs-major-version 20))\n")
  1435.       (princ "       (fboundp 'load-options-file))\n")
  1436.       (princ "  (load-options-file \"")
  1437.       (princ actual-save-options-file)
  1438.       (princ "\")))\n")
  1439.       (princ ";; ============================\n")
  1440.       (princ ";; End of Options Menu Settings\n"))
  1441.  
  1442.     (set-marker init-output-marker nil)
  1443.     (save-excursion
  1444.       (set-buffer init-output-buffer)
  1445.       (save-buffer))
  1446.     ))
  1447.  
  1448.  
  1449. (set-menubar default-menubar)
  1450.  
  1451.  
  1452. ;;; Popup menus.
  1453.  
  1454. (defconst default-popup-menu
  1455.   '("XEmacs Commands"
  1456.     :filter edit-menu-filter
  1457.     ["Undo"        advertised-undo        t]
  1458.     ["Cut"        x-kill-primary-selection   t]
  1459.     ["Copy"        x-copy-primary-selection   t]
  1460.     ["Paste"        x-yank-clipboard-selection t]
  1461.     ["Clear"            x-delete-primary-selection t]
  1462.     "-----"
  1463.     ["Select Block"    mark-paragraph         t]
  1464.     ["Split Window"    (split-window)        t]
  1465.     ["Unsplit Window"     delete-other-windows    t]
  1466.     ))
  1467.  
  1468. (defvar global-popup-menu nil
  1469.   "The global popup menu.  This is present in all modes.
  1470. See the function `popup-menu' for a description of menu syntax.")
  1471.  
  1472. (defvar mode-popup-menu nil
  1473.   "The mode-specific popup menu.  Automatically buffer local.
  1474. This is appended to the default items in `global-popup-menu'.
  1475. See the function `popup-menu' for a description of menu syntax.")
  1476. (make-variable-buffer-local 'mode-popup-menu)
  1477.  
  1478. ;; In an effort to avoid massive menu clutter, this mostly worthless menu is
  1479. ;; superceded by any local popup menu...
  1480. (setq-default mode-popup-menu default-popup-menu)
  1481.  
  1482. (defvar activate-popup-menu-hook nil
  1483.   "Function or functions run before a mode-specific popup menu is made visible.
  1484. These functions are called with no arguments, and should interrogate and
  1485. modify the value of `global-popup-menu' or `mode-popup-menu' as desired.
  1486. Note: this hook is only run if you use `popup-mode-menu' for activating the
  1487. global and mode-specific commands; if you have your own binding for button3,
  1488. this hook won't be run.")
  1489.  
  1490. (defun popup-mode-menu ()
  1491.   "Pop up a menu of global and mode-specific commands.
  1492. The menu is computed by combining `global-popup-menu' and `mode-popup-menu'."
  1493.   (interactive "@_")
  1494.   (run-hooks 'activate-popup-menu-hook)
  1495.   (popup-menu
  1496.    (cond ((and global-popup-menu mode-popup-menu)
  1497.       (check-menu-syntax mode-popup-menu)
  1498.       (let* ((title (car mode-popup-menu))
  1499.          (items (cdr mode-popup-menu))
  1500.          filters)
  1501.         ;; Strip keywords from local menu for attaching them at the top
  1502.         (while (and items
  1503.             (symbolp (car items)))
  1504.           (setq items (append filters (list (car items))))
  1505.           (setq items (cdr items)))
  1506.         ;; If filters contains a keyword already present in
  1507.         ;; `global-popup-menu' you will probably lose.
  1508.         (append (list (car global-popup-menu))
  1509.             filters
  1510.             (cdr global-popup-menu)
  1511.             '("---" "---")
  1512.             (if popup-menu-titles (list title))
  1513.             (if popup-menu-titles '("---" "---"))
  1514.             items)))
  1515.      (t
  1516.       (or mode-popup-menu
  1517.           global-popup-menu
  1518.           (error "No menu here."))))))
  1519.  
  1520. (defun popup-buffer-menu (event) 
  1521.   "Pop up a copy of the Buffers menu (from the menubar) where the mouse is clicked."
  1522.   (interactive "e")
  1523.   (let ((window (and (event-over-text-area-p event) (event-window event)))
  1524.     (bmenu nil))
  1525.     (or window
  1526.     (error "Pointer must be in a normal window"))
  1527.     (select-window window)
  1528.     (if current-menubar
  1529.      (setq bmenu (assoc "Buffers" current-menubar)))
  1530.     (if (null bmenu)
  1531.      (setq bmenu (assoc "Buffers" default-menubar)))
  1532.     (if (null bmenu)
  1533.      (error "Can't find the Buffers menu"))
  1534.     (popup-menu bmenu)))
  1535.  
  1536. (defun popup-menubar-menu (event) 
  1537.   "Pop up a copy of menu that also appears in the menubar"
  1538.   ;; by Stig@hackvan.com
  1539.   (interactive "e")
  1540.   (let ((window (and (event-over-text-area-p event) (event-window event)))
  1541.     popup-menubar)
  1542.     (or window
  1543.     (error "Pointer must be in a normal window"))
  1544.     (select-window window)
  1545.     (and current-menubar (run-hooks 'activate-menubar-hook))
  1546.     ;; ##### Instead of having to copy this just to safely get rid of
  1547.     ;; any nil what we should really do is fix up the internal menubar
  1548.     ;; code to just ignore nil if generating a popup menu
  1549.     (setq popup-menubar (delete nil (copy-sequence (or current-menubar
  1550.                                default-menubar))))
  1551.     (popup-menu (cons "Menubar Menu" popup-menubar))
  1552.     ))
  1553.  
  1554. (global-set-key 'button3 'popup-mode-menu)
  1555. ;; shift button3 and shift button2 are reserved for Hyperbole
  1556. (global-set-key '(meta control button3) 'popup-buffer-menu)
  1557. ;; The following command is way too dangerous with Custom.
  1558. ;; (global-set-key '(meta shift button3) 'popup-menubar-menu)
  1559.  
  1560. ;; Here's a test of the cool new menu features (from Stig).
  1561.  
  1562. ;(setq mode-popup-menu
  1563. ;      '("Test Popup Menu"
  1564. ;        :filter cdr
  1565. ;        ["this item won't appear because of the menu filter" ding t]
  1566. ;        "--:singleLine"
  1567. ;        "singleLine"
  1568. ;        "--:doubleLine"
  1569. ;        "doubleLine"
  1570. ;        "--:singleDashedLine"
  1571. ;        "singleDashedLine"
  1572. ;        "--:doubleDashedLine"
  1573. ;        "doubleDashedLine"
  1574. ;        "--:noLine"
  1575. ;        "noLine"
  1576. ;        "--:shadowEtchedIn"
  1577. ;        "shadowEtchedIn"
  1578. ;        "--:shadowEtchedOut"
  1579. ;        "shadowEtchedOut"
  1580. ;        "--:shadowDoubleEtchedIn"
  1581. ;        "shadowDoubleEtchedIn"
  1582. ;        "--:shadowDoubleEtchedOut"
  1583. ;        "shadowDoubleEtchedOut"
  1584. ;        "--:shadowEtchedInDash"
  1585. ;        "shadowEtchedInDash"
  1586. ;        "--:shadowEtchedOutDash"
  1587. ;        "shadowEtchedOutDash"
  1588. ;        "--:shadowDoubleEtchedInDash"
  1589. ;        "shadowDoubleEtchedInDash"
  1590. ;        "--:shadowDoubleEtchedOutDash"
  1591. ;        "shadowDoubleEtchedOutDash"
  1592. ;        ))
  1593.  
  1594. (defun xemacs-splash-buffer ()
  1595.   "Redisplay XEmacs splash screen in a buffer."
  1596.   (interactive)
  1597.   (let ((buffer (get-buffer-create "*Splash*")))
  1598.     (set-buffer buffer)
  1599.     (erase-buffer buffer)
  1600.     (startup-splash-frame)
  1601.     (pop-to-buffer buffer)
  1602.     (delete-other-windows)))
  1603.  
  1604. (provide 'x-menubar)
  1605.  
  1606. ;;; x-menubar.el ends here.
  1607.